perm filename INPSS.F4[DRW,LCS] blob sn#056115 filedate 1974-12-13 generic text, type T, neo UTF8
00100		DIMENSION BUF1(1000),BUF2(1000)
00200		COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
00300		DATA Z/20./,ZZ/20./,XX/60./
00400	10	TYPE 1
00500		ACCEPT 2,X
00600	1	FORMAT(' TYPE PAIRS OF NUMS.'/)
00700	2	FORMAT(100F)
00800		DO 3 K=1,100,2
00900		IF(X(K).EQ.999.)GO TO 4
01000		X(K/2+1)=X(K)
01100		Y(K/2+1)=X(K+1)
01200	3	CONTINUE
01300	4	N=K/2
01400		CALL DPYSET(1,BUF1,1000)
01500		CALL AIVECT(IFIX(X(1)*Z),IFIX(Y(1)*Z))
01600		DO 6 K=2,N
01700	6	CALL AVECT(IFIX(X(K)*Z),IFIX(Y(K)*Z))
01800		CALL DPYOUT(1)
01900		CALL SS
02000		CALL DPYSET(2,BUF2,1000)
02100		CALL AIVECT(IFIX(X1(1)*ZZ+XX),IFIX(Y1(1)*ZZ))
02200		DO 5 K=2,512
02300	5	CALL AVECT(IFIX(X1(K)*ZZ+XX),IFIX(Y1(K)*ZZ))
02400		CALL DPYOUT(2)
02500		GO TO 10
02600		END